inst/equity-research/app v2.R
In zac-garland/equityresearch: Equity Research in R
options(shiny.autoreload = TRUE)
# Header ------------------------------------------------
header <- dashboardHeader(title = shiny::tags$a(shiny::tags$img(src = "logo_r_equity_research.svg",width = "200",height = "31")))
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(
sidebarSearchForm(textId = "ticker_1", buttonId = "searchButton",
label = "Ticker..." ),
sidebarMenu(id = 'sidebarmenu',
# Equity Overview -------------------------
menuItem('Watchlist',
tabName = 'overview',
icon = icon('dedent'),
menuSubItem("Watchlist",
tabName = 'watchlist')
),
# News--------------------
menuItem('Equity Overview (beta)',
tabName = 'news',
icon = icon('newspaper-o'),
menuSubItem("Overview",
tabName = "news_dt"),
conditionalPanel("input.sidebarmenu === 'news_dt'",
selectizeInput(inputId = 'news_sources',
label = 'News Sources',
choices = c("Seeking Alpha" = "seekingalpha.com",
"The Motley Fool" = "fool.com",
"Market Watch" = "marketwatch.com",
"CNBC" = "cnbc.com",
"Reuters" = "reuters.com",
"Nasdaq" = "nasdaq.com",
"Bloomberg" = "bloomberg.com",
"Yahoo Finance" = "finance.yahoo.com",
"Zacks" = "zacks.com",
"Wall Street Journal" = "wsj.com",
"Barrons" = "barrons.com"),
multiple = TRUE,
selected = NULL),
selectInput("news_lex",
"Lexicon:",
choices = c("NRC" = "nrc",
"Bing" = "bing",
"AFINN" = "afinn",
"Loughran" = "loughran")),
checkboxInput(inputId = "sent_filt",value = FALSE,
label = "Use Lexicon")
)),
# Filings------------------------------
menuItem('Filings',
tabName = 'Filings',
icon = icon('file'),
menuSubItem("Transcripts",
tabName = "tra_script"),
# conditionalPanel("input.sidebarmenu === 'tra_script'",
# textInput("search", "Search")),
menuSubItem("10-K's and Q's",
tabName = "ten_k_q"),
menuSubItem("8-K",
tabName = "eight_k"),
menuSubItem("Prospectus'",
tabName = "prospectus"),
menuSubItem("Proxy Statements",
tabName = "proxy"),
menuSubItem("Beneficial Ownership",
tabName = "thirteen")),
# Technical Indicators--------------------
menuItem("Technical Indicators",
tabName = 'tech_chart',
icon = icon('random'),
dateRangeInput("tech_date_range",
"Date range:",
start = Sys.Date() %m-% years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
menuSubItem("RSI","tab_ind_rsi"),
menuSubItem("MACD","tab_ind_macd"),
menuSubItem("Bollinger Bands","tab_ind_bbands"),
menuSubItem("Stochastic Oscillator","tab_ind_stoch"),
menuSubItem("Commondity Channel Index","tab_ind_cci"),
menuSubItem("AROON","tab_ind_aroon"),
menuSubItem("On Balance Volume","tab_ind_obv"),
menuSubItem("ADX","tab_ind_adx"),
menuSubItem("Simple MA","tab_ind_sma"),
menuSubItem("Exponential MA", "tab_ind_ema"),
conditionalPanel("input.sidebarmenu === 'tab_ind_rsi'",
numericInput("rsi_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_macd'",
numericInput("macd_nfast","Fast:",value = 12),
numericInput("macd_nslow","Slow:",value = 26),
numericInput("macd_nsig","Signal:",value = 9)),
conditionalPanel("input.sidebarmenu === 'tab_ind_bbands'",
numericInput("bbands_n","Periods:",value = 20),
numericInput("bbands_sd", "Std Dev:", value = 2)),
conditionalPanel("input.sidebarmenu === 'tab_ind_stoch'",
numericInput("stoch_fastk","Fast K:",value = 14),
numericInput("stoch_fastd", "Fast D",value = 3),
numericInput("stoch_slowd","Slow D",value = 3)),
conditionalPanel("input.sidebarmenu === 'tab_ind_cci'",
numericInput("cci_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_aroon'",
numericInput("aroon_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_adx'",
numericInput("adx_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_sma'",
numericInput("sma_one","Periods:",value = 50),
numericInput("sma_two","Periods:",value = 200)),
conditionalPanel("input.sidebarmenu === 'tab_ind_ema'",
numericInput("ema_one","Periods:",value = 20),
numericInput("ema_two","Periods:",value = 50))
),
# Pricing Data-----------------------
menuItem('Prices, Risk, & Returns',
tabName = 'pricing_data',
icon = icon('line-chart'),
# Returns Data --------------------
menuSubItem('Risk & Returns Data',
tabName = 'returns_data'),
conditionalPanel("input.sidebarmenu === 'returns_data'",
textInput("returns_benchmark",
label = "Benchmark",
value = "SPY"),
dateRangeInput("returns_date_range",
"Date range:",
start = Sys.Date() - years(2),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
selectInput("returns_freq", "Chart Frequency:",
c("Daily" = "daily",
"Monthly" = "monthly",
"Yearly" = "yearly"),"daily")
),
menuSubItem("Pricing Data",
tabName = 'price_data'),
conditionalPanel("input.sidebarmenu === 'price_data'",
dateRangeInput("price_date_range",
"Date range:",
start = Sys.Date() - years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date())
)
)
))
# Body ------------------------------------------------
body <- dashboardBody(shiny::tags$script(HTML("$('body').addClass('sidebar-mini');")),
# shiny::tags$style(HTML("")),
shiny::tags$style(".nav-tabs {background: #f4f4f4;}
.nav-tabs-custom .nav-tabs li.active:hover a, .nav-tabs
custom .nav-tabs li.active a {background-color: transparent;
border-color: transparent;
}
.nav-tabs-custom .nav-tabs li.active {border-top-color:
#314a6d;
}
"
),
# tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "add-on.css")),
# Equity Overview ----------------------------------
tabItems(
tabItem(tabName = "watchlist",
fluidRow(
column(6,
shinydashboard::box(id = "tabset_watch",
height = "550px",
width = 12,
withSpinner(dataTableOutput("watchlist_dt"))
)),
column(6,
tabBox(id = "tabset_2",
height = "550px",
width = 12,
tabPanel("Top % Chg",
br(),
br(),
withSpinner(plotlyOutput("top_btm_chart"))),
tabPanel("News",
withSpinner(uiOutput("watchlist_news_dt"))),
tabPanel("Return Stats",
fluidRow(column(1),
column(5,
br(),
withSpinner(htmlOutput("return_stats_one"))),
# column(1),
column(6,
br(),
withSpinner(htmlOutput("return_stats_two"))))
# , output
),
tabPanel("Relative Perf",
withSpinner(plotlyOutput("ret_perf"))),
tabPanel("Key Stats",
br(),
br(),
withSpinner(dataTableOutput("key_stats")))
))
),
fluidRow(
column(12,
shinydashboard::box(id = "watchlist_4",
height = "750px",
width = 12,
withSpinner(dataTableOutput("filing_short")))
))
),
tabItem(tabName = "equity_overview",
fluidRow(column(7,h2(textOutput("company_name")))),
fluidRow(column(2,h2(textOutput("current_price"))),
column(1,h2(htmlOutput("price_chg"))),
column(2, h2(htmlOutput("pct_chg"))),
column(3,h3(textOutput("as_of"))),
column(2,h3(textOutput("currency_in")))),
fluidRow(column(12,withSpinner(highchartOutput("stock_chart")))),
fluidRow(column(12,dataTableOutput("equity_stats")))
),
# Technical Indicators---------------
tabItem(tabName = "tab_ind_sma",
fluidRow(column(12, withSpinner(highchartOutput("ind_sma", height = "850px"))))),
tabItem(tabName = "tab_ind_ema",
fluidRow(column(12, withSpinner(highchartOutput("ind_ema", height = "850px"))))),
tabItem(tabName = "tab_ind_macd",
fluidRow(column(12, withSpinner(highchartOutput("ind_macd", height = "850px"))))),
tabItem(tabName = "tab_ind_stoch",
fluidRow(column(12, withSpinner(highchartOutput("ind_stoch", height = "850px"))))),
tabItem(tabName = "tab_ind_rsi",
fluidRow(column(12, withSpinner(highchartOutput("ind_rsi", height = "850px"))))),
tabItem(tabName = "tab_ind_cci",
fluidRow(column(12, withSpinner(highchartOutput("ind_cci", height = "850px"))))),
tabItem(tabName = "tab_ind_aroon",
fluidRow(column(12, withSpinner(highchartOutput("ind_aroon", height = "850px"))))),
tabItem(tabName = "tab_ind_obv",
fluidRow(column(12, withSpinner(highchartOutput("ind_obv", height = "850px"))))),
tabItem(tabName = "tab_ind_adx",
fluidRow(column(12, withSpinner(highchartOutput("ind_adx", height = "850px"))))),
tabItem(tabName = "tab_ind_bbands",
fluidRow(column(12, withSpinner(highchartOutput("ind_bbands", height = "850px"))))),
# Pricing Data ----------------------------------
tabItem(tabName = "price_data",
fluidRow(column(12,withSpinner(highchartOutput("price_chart")))),
half_row(rHandsontableOutput("pricing_dt", height = "600px"),
plotlyOutput("div_plot", height = "600px"))
),
# Returns Data ----------------------------------
tabItem(tabName = "returns_data",
withSpinner(fluidRow(column(2,br(),htmlOutput("returns_dt")),
column(10,
DTOutput("key_returns"),
br(),
plotlyOutput("performance_chart"),
br(),
DTOutput("calendar_returns"))))
),
# News-------------------------------------------
tabItem(tabName = "news_dt",
fluidRow(column(6,h2(textOutput("title_1")),
withSpinner(dataTableOutput("key_info"))),
column(6,
h2(textOutput("title_3")),
br(),
withSpinner(htmlOutput("descrip")))
),
fluidRow(column(7,h2(textOutput("title_4")),
br(),br(),br(),wordcloud2Output("news_cloud",width="100%"))),
fluidRow(column(12,withSpinner(DT::DTOutput("news_dtt"))))
),
# Portfolio Optimization----------------------------
tabItem(tabName = "tab_markowitz_optimization",
fluidRow(column(12,plotlyOutput("markowitz_optimization", height = "850px")))),
tabItem(tabName = "tab_backtesting_mo",
fluidRow(column(12,plotlyOutput("backtesting_mo", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier",
fluidRow(column(12,plotlyOutput("efficient_frontier", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier_constraints",
fluidRow(column(12,plotlyOutput("efficient_frontier_constraints", height = "850px")))),
tabItem(tabName = "tab_portfolio_analytics",
fluidRow(column(6,plotlyOutput("portfolio_analytics_min_sd", height = "850px")),
column(6,plotlyOutput("portfolio_analytics_min_es", height = "850px")))),
tabItem(tabName = "tab_compare_risk",
fluidRow(column(12,plotlyOutput("compare_risk_measures", height = "850px")))),
tabItem(tabName = "tab_active_extension",
fluidRow(column(12,plotlyOutput("active_extension", height = "850px")))),
# Filings -----------------------------------
tabItem(tabName = "tra_script",
full_row(wordcloud2Output("word_cloud",height = "500px")),
# half_row(dataTableOutput("tr_df"),plotlyOutput("sent_chart", height ="auto")),
# full_row(),
full_row(br()),
full_row(br()),
full_row(plotlyOutput("sent_chart", height ="500px", width = "100%")),
full_row(br()),
full_row(br()),
# full_row(),
full_row(textInput("search", "Search")),
full_row(htmlOutput("some_text"))
),
tabItem(tabName = "ten_k_q",
full_row(withSpinner(plotlyOutput("ten_k_plot"))),
fluidRow(column(12,dataTableOutput("ten_k_q_table")))
),
tabItem(tabName = "eight_k",
full_row(withSpinner(plotlyOutput("eight_k_plot"))),
fluidRow(column(12,dataTableOutput("eight_k_table")))
),
tabItem(tabName = "prospectus",
full_row(withSpinner(plotlyOutput("pros_plot"))),
fluidRow(column(12,dataTableOutput("prospectus_table")))
),
tabItem(tabName = "proxy",
full_row(withSpinner(plotlyOutput("proxy_plot"))),
fluidRow(column(12,dataTableOutput("proxy_table")))
),
tabItem(tabName = "thirteen",
full_row(withSpinner(plotlyOutput("thirteen_plot"))),
fluidRow(column(12,dataTableOutput("thirteen_table")))
),
# Screening---------------------------------------------
tabItem(
tabName = "constits",
fluidRow(class = "text-center",column(12,h3(textOutput("index_name")))),
half_row(br(),br()),
half_row(withSpinner(highchartOutput("index_tree")),
withSpinner(plotlyOutput("index_top"))),
full_row(br()),
full_row(withSpinner(dataTableOutput("index_screen")))
),
tabItem(
tabName = "screen",
fluidRow(
tabBox(id = "screen_tab_box",
width = 12,
tabPanel("Screen",
fluidRow(column(3,rHandsontableOutput("hot_three")),
column(9,withSpinner(rHandsontableOutput("filtered_results_r",
height = "900px"))))),
tabPanel("Visualize",
full_row(uiOutput("hist_select")),
half_row(withSpinner(plotlyOutput("screen_box")),withSpinner(plotlyOutput("screen_hist"))),
half_row(br(),br()),
fluidRow(column(6,plotlyOutput("screen_perf")),
column(6,highchartOutput("screen_tree"))))
))
),
tabItem(
tabName = "hc",
tabBox(id = "hc_tab",
width = 12,
tabPanel("Cluster Cor",
full_row(withSpinner(rHandsontableOutput("cor_mx", height = "1500px")))),
tabPanel("Risk / Returns",
fluidRow(column(2,br(),withSpinner(htmlOutput("clust_returns_dt"))),
column(10,
withSpinner(highchartOutput("clust_tree")),
br(),
withSpinner(plotlyOutput("ret_filt"))))
),
tabPanel("Current Screen",
full_row(withSpinner(rHandsontableOutput("clust_screen", height = "900px")))))
#
# fluidRow(column(12,withSpinner(rHandsontableOutput("cor_mx", height ="900px")))),
#
# # full_row(rHandsontableOutput("cor_mx")),
# full_row(plotlyOutput("ret_filt"))
)
))
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(title = "Equity Research",
header,
sidebar,
body,
skin = "black"
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){
# Watchlist Script------------------------------------------------
output$polar_chart <- renderPlotly({
plot_ly(type = 'scatterpolar',
fill = 'toself') %>%
add_trace(
r = c(25,25,25,0,0,0),
theta = c("Consulting","Education","Analyst","Asset Management","Coding","Data Science"),
name = 'Experience',
fillcolor = 'rgba(55, 128, 191, 0.5)',
marker = list(color = "black")
) %>%
add_trace(
r = c(0,0,25,25,25,25),
theta = c("Consulting","Education","Analyst","Asset Management","Coding","Data Science"),
name = 'Capstone',
fillcolor = 'rgba(50, 171, 96, 0.5)',
marker = list(color = "black")
) %>%
layout(polar = list(radialaxis = list(visible = T,
range = c(0,50))),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$ideal_map <- renderHighchart({
ideal_location()
})
output$invest_style <- renderPlotly({
my_style %>%
# group_by(category) %>%
arrange(desc(value)) %>%
mutate(name = as_factor(name)) %>%
# mutate(row_n = 1:nrow(.)) %>% arrange(desc(row_n)) %>%
# arrange(order) %>%
# mutate(category = fct_reorder(category,order)) %>%
plot_ly(x = ~value,
y = ~category,
# sort = F,
type = "bar",
color = ~value,
colors = 'Blues',
# marker = list(color = ~color),
orientation = "h",
name = ~name) %>%
layout(yaxis = list(title = ''),
xaxis = list(title = ''),
barmode = 'stack') %>%
hide_colorbar() %>%
layout(legend = list(orientation = 'h', y = -0.1),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$watchlist_dt <- renderDataTable({
q_quotes %>%
arrange(desc(pct_chg)) %>%
mutate(green_red = as.numeric(ifelse(chg>0,1,0))) %>%
datatable(rownames = F,
selection = 'single',
options = list(scrollX = TRUE,
columnDefs = list(list(targets = 9, visible = FALSE))
)) %>%
formatPercentage("pct_chg",2) %>%
formatStyle(c('pct_chg'),'green_red',
backgroundColor = styleEqual(c(1, 0), c('rgba(50, 171, 96, 0.5)', 'rgba(219, 64, 82, 0.5)')))
})
output$top_btm_chart <- renderPlotly({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to Compare Performance"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_quotes <- q_quotes %>%
mutate(rank = min_rank(desc(pct_chg))) %>% filter(rank <= 5 | rank >= (max(rank,na.rm=T)-5)) %>% select(-rank)
q_quotes %>%
arrange(pct_chg) %>%
mutate(color = ifelse(pct_chg>0,'rgba(50, 171, 96, 0.7)', 'rgba(219, 64, 82, 0.7)')) %>%
mutate(symbol = as_factor(symbol)) %>%
plot_ly(x = ~pct_chg,
y = ~symbol,
type = 'bar',
orientation = 'h',
marker = list(color = ~color)) %>%
add_annotations(x = q_quotes$pct_chg/2,
y = q_quotes$symbol,
text = q_quotes$symbol,
xref = "x",
yref = "y",
showarrow = F,
font = list(color = '#ffffff',
family = 'sans serif',
size = 20)) %>%
layout(xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
zeroline = F,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE),
showlegend = F)
})
# output$watchlist_news_dt <- DT::renderDataTable({
#
# validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Company News"))
# req(input$watchlist_dt_rows_selected)
#
# # s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
# s <- input$watchlist_dt_rows_selected
#
# ticker <- q_quotes %>%
# arrange(desc(pct_chg)) %>%
# .[[s,1]]
#
#
# company_news <- q_news(ticker) %>%
# dplyr::select(title,description,source,published_date,url) %>%
# dplyr::mutate(description = ifelse(str_length(description)>=350,
# paste0(str_sub(description,1,350),
# "..."),
# description)) %>%
# mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
# source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
# dplyr::select(-url,-description)
#
#
# dt <- company_news %>%
# DT::datatable(rownames = F,selection = 'single',
# escape = F,
# class = 'cell-border stripe',
# extensions = c('ColReorder','Scroller'),
# options = list(colReorder = TRUE,
# deferRender = T,
# pageLength = 5))
#
#
# dt %>% formatDate(4,'toUTCString') %>%
# DT::formatStyle(columns = 1, fontSize = '20px')
#
#
#
#
# })
output$watchlist_news_dt <- renderUI({
test <- function(title,link,date,descrip){
shiny::HTML(paste0('
<div class="row">
<h3><a href=',link,'>',title,' </a></h3>
<span>',date,'</span>
<br>
</div>
<div class="row">
',descrip,'
</div>
'))
}
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Company News"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_news(ticker) %>%
rowid_to_column() %>%
split(.$rowid) %>%
map(~{
test(
title = .$item_title,
link = .$item_link,
date = .$item_date_published,
descrip = .$item_description %>% str_sub(1,500)
)
}) %>%
shiny::div(style="overflow-y: scroll;height:400px;")
})
output$return_stats_one <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_one(ticker,"SPY")
})
output$return_stats_two <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_two(ticker,"SPY")
})
# Performance Chart-----------------------------
output$ret_perf <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
ticks <- c(ticker,"SPY")
# plot -----------------------
plot.df <- q_price(ticks,
start_date = Sys.Date() - years(2),
frequency = "daily")%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = "daily",
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,"Daily Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = ""))
})
output$key_stats <- renderDataTable({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Key Stats"))
# Yahoooo Key Stats
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- q_key_stats(ticker)
DT::datatable(df,
colnames = c("","","",""),
rownames = FALSE,
selection = 'none', options = list(dom = 't',
bSort=FALSE,
columnDefs = list(
list(className = 'dt-right', targets = c(1,3)))))
})
output$sm_eq_inc_dt <- renderText({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Financials"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_inc_fmt_tbl(ticker,n = 3)
})
# Assets Sub Plot---------------------------------------------
output$sm_eq_assets_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_bal_fmt_tbl(ticker,n = 3)
})
output$sm_eq_liab_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_bal_fmt_tbl(ticker,
selection = "liab",
n = 3)
})
output$sm_eq_equity_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_bal_fmt_tbl(ticker,
selection = "equity",
n = 3)
})
output$sm_eq_cf_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_cf_fmt_tbl(ticker,
n = 3)
})
output$filing_short <- renderDataTable({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
filings <- company_filings(ticker , count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$own_pie <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- Quandl.datatable("SHARADAR/SF3", ticker = ticker,
paginate = T, securitytype = "SHR",
calendardate.gte=as.character(Sys.Date()-days(180))) %>%
filter(calendardate == max(calendardate)) %>%
select(-c(ticker,securitytype)) %>%
as_tibble()
all_sh_sum <- sum(df$value)
inst_data <- df %>%
mutate(top_5 = ifelse(min_rank(desc(value))<= 5, investorname,"OTHER")) %>%
group_by(top_5) %>%
summarize(pct_by_group = sum(value,na.rm = T)/all_sh_sum) %>%
mutate(lev = ifelse(top_5 == "Other",dplyr::n()+1,min_rank(desc(pct_by_group)))) %>%
arrange(lev) %>%
mutate(top_5 = factor(top_5,unique(top_5)))
inst_data %>%
plot_ly(labels = ~top_5,
values = ~pct_by_group,
type = 'pie')
})
# Equity Overview Script ----------------------------------------
output$title_1 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Info")
})
output$title_3 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Description")
})
output$title_4 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Frequent News Buzzwords")
})
output$key_info <- renderDataTable({
req(input$ticker_1)
key_info <- Quandl.datatable("SHARADAR/TICKERS",ticker = input$ticker_1) %>%
filter(table == "SF1") %>%
select(ticker,name,exchange,sicsector,sicindustry,location,secfilings,companysite) %>%
rename(sector = sicsector,
industry = sicindustry) %>%
gather(key,value)
key_info %>%
bind_cols(q_key_stats(input$ticker_1)) %>%
mutate(value = ifelse(key %in% c("secfilings","companysite"),
paste0("<a href='",value,"' target='_blank'>","Link","</a>"),
value)) %>%
mutate(key = str_to_title(key)) %>%
as_tibble() %>%
datatable(rownames = F,
colnames=c("", "","","","",""),
escape = F,
options = list(dom = 't',ordering=F))
})
output$descrip <- renderText({
req(input$ticker_1)
paste0("<h4>",q_descrip(input$ticker_1),"</h4>")
# descrip <- descrip %>%
# str_split(" ") %>%
# as_vector() %>%
# tibble(word = .) %>%
# mutate(word = ifelse(!(word %in% stop_words$word),
# paste0("<b>",word,"</b>"),
# paste0('<font color = "#ECF0F5">',word,"</font>"))) %>%
# pull(word) %>%
# paste(sep = " ",collapse = " ")
#
# paste0("<h4>",descrip,"</h4>")
# %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# inner_join(sentiments) %>%
# distinct(word) %>%
# mutate(word = paste(word,"<br>")) %>%
# pull()
# descrip %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# pull(word) %>%
# paste(sep = "",collapse = "")
# as.vector(strsplit(descrip, '\\. ')) %>%
# tibble(word = .) %>%
# unnest(word) %>%
# mutate(line = 1:nrow(.)) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# nest(word) %>%
# mutate(text = map(data,unlist),
# text = map_chr(text, paste, collapse = " "),
# text = paste(text,"<br>")) %>%
# pull(text)
})
# IS Waterfall Chart---------------------------------------------
output$waterfall_chart <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
df <- q_income_statement(ticker, dimension = paste0(input$fund_dim,input$fund_freq))
df <- df[1,]
dat_graph <- tibble(x = c('Revenue','COGS','Gross Margin','Op Ex','RND','SGA','Op Income','Other Inc','EBIT','Interest and Taxes','Net Income'),
base = c(0, df$q_gross_profit,0,df$q_oper_inc,(df$q_gross_profit - df$q_rnd), df$q_oper_inc, 0,ifelse(df$q_other_income >0,
df$q_oper_inc,
df$q_oper_inc + df$q_other_income),
0, ifelse(df$q_interest_nd_tax > 0, df$q_ebit, df$q_ebit + df$q_interest_nd_tax),0),
revenues = c(df$q_revenue,
rep(0,6),
ifelse(df$q_other_income >0 , df$q_other_income,0),
0,
ifelse(df$q_interest_nd_tax > 0, df$q_interest_nd_tax,0),
0),
costs = c(0, df$q_cogs, 0,
df$q_oper_exp,
df$q_rnd,
df$q_sgna,
0,
ifelse(df$q_other_income < 0 , -df$q_other_income,0),
0,
ifelse(df$q_interest_nd_tax < 0, -df$q_interest_nd_tax,0),
0),
profit = c(0,0,df$q_gross_profit,
rep(0,3),
df$q_oper_inc,
0,
df$q_ebit,
0, df$q_net_inc))
dat_graph <- dat_graph %>%
filter(!(x %in% c("RND","SGA"))) %>%
mutate(y = ifelse(costs == 0, sum(base,revenues,costs,profit)/2, base + (costs/2)))
#The default order will be alphabetized unless specified as below:
dat_graph$x <- factor(dat_graph$x, levels = dat_graph[["x"]])
plot_ly(dat_graph,
x = ~x,
y = ~base,
type = 'bar',
marker = list(color = 'rgba(1,1,1, 0.0)')) %>%
add_trace(y = ~revenues,
marker = list(color = 'rgba(55, 128, 191, 0.7)',
line = list(color = 'rgba(55, 128, 191, 0.7)',
width = 2))) %>%
add_trace(y = ~costs,
marker = list(color = 'rgba(219, 64, 82, 0.7)',
line = list(color = 'rgba(219, 64, 82, 1.0)',
width = 2))) %>%
add_trace(y = ~profit,
marker = list(color = 'rgba(50, 171, 96, 0.7)',
line = list(color = 'rgba(50, 171, 96, 1.0)',
width = 2))) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)',
showlegend = FALSE)
})
# Income Statement DataTable--------------------------------------------------
output$income_statement_dt <- renderText({
req(input$ticker_1)
q_inc_fmt_tbl(ticker = input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq))
})
# BS Treemap--------------------------------------------------
output$balance_sheet_treemap <- renderHighchart({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
bal_sheet <- q_balance_sheet(ticker,dimension = paste0(input$fund_dim,input$fund_freq)) %>%
dplyr::select(q_cal_date,
q_cash,
q_invest_curr,
q_receivables,
q_inventory,
q_other_curr_assets,
q_invest_non_curr,
q_ppe,
q_assets_good_intang,
q_other_non_curr_assets,
q_payables,
q_debt_curr,
q_other_curr_liab,
q_debt_non_curr,
q_other_non_curr_liab,
q_retained_earn,
q_other_equity)
# Generate Data for Treemap ---------------------
tm <- bal_sheet %>%
dplyr::filter(q_cal_date == max(q_cal_date, na.rm = T)) %>%
gather(q_lo,value, -q_cal_date) %>%
left_join(bal_sheet_tree_ref, by = "q_lo") %>%
rename(descrip = name) %>%
mutate_at("main_group", str_replace,"Equity", "Shareholders Equity") %>%
mutate(color_numeric = as.numeric(as.factor(main_group)))
# Generate Data Classes Colors------------------------------------------
data_classes <- list(list(from = 1,
to = 1,
color = "#3780bf",
name = "Assets"),
list(from = 2,
to = 2,
color = "#db4052",
name = "Liabilities"),
list(from = 3,
to = 3,
color = "#32ab60",
name = "Shareholders Equity"))
hctreemap2(tm,
group_vars = c("main_group","sub_group","descrip"),
size_var = "value",
color_var = "color_numeric",
layoutAlgorithm = "squarified") %>%
hc_colorAxis(
dataClassColor = "category",
dataClasses = data_classes
)
})
# Balance Sheet Data Tables ----------------------------
output$assets_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,dimension = paste0(input$fund_dim,input$fund_freq))
})
output$liab_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq),
selection = "liab")
})
output$equity_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq),
selection = "equity")
})
# CF Graph ---------------------------------------
output$cf_graph <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
cf_statement <- q_cash_flow_statement(ticker, dimension = paste0(input$fund_dim,input$fund_freq)) %>%
slice(1:10)
if(!is.null(input$cf_item)){
cf_statement %>%
select(q_cal_date,input$cf_item) %>%
gather(indicator,value,-q_cal_date) %>%
plot_ly(x = ~q_cal_date,
y = ~value,
color = ~indicator,
type = "bar") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
}
})
# CF Data Tables----------------------------------------
output$cf_dt <- renderText({
req(input$ticker_1)
q_cf_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq))
})
# Fundamental Indicators--------------------------------
ticker_price <- reactive({
req(input$ticker_1)
# req(input$compare_ticker)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
ticker_price <- tq_get(ticker)
if(!("symbol" %in% colnames(ticker_price))){
ticker_price <- ticker_price %>% mutate(symbol = input$ticker_1)
}
ticker_price <- ticker_price %>%
select(symbol,date,adjusted) %>%
spread(symbol,adjusted)
ticker_price <-seq.Date(min(ticker_price$date),max(ticker_price$date),by = "days") %>%
tibble(date = .) %>%
left_join(ticker_price, by = "date") %>%
fill(-date) %>%
gather(symbol,adjusted,-date)
ticker_price
})
# Earnings Yield
output$earnings_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_eps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(earnings_yield = q_eps/adjusted) %>%
select(-c(q_eps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = earnings_yield,
group = q_ticker)) %>%
hc_title(text = "Earnings Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Dividend Yield div/price
output$div_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_divs_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(dividend_yield = q_divs_ps/adjusted) %>%
select(-c(q_divs_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = dividend_yield,
group = q_ticker)) %>%
hc_title(text = "Dividend Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Book Value PS/ Price
output$book_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_bv_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(book_yield = q_bv_ps/adjusted) %>%
select(-c(q_bv_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = book_yield,
group = q_ticker)) %>%
hc_title(text = "Book to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Operating CF Yield OCF PS/Price
output$ocf_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cf_oper","q_shares"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(oper_cf_yield = (q_cf_oper/q_shares)/adjusted) %>%
select(-c(q_cf_oper,q_shares,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = oper_cf_yield,
group = q_ticker)) %>%
hc_title(text = "Operating Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# FCF Yield PS / Price
output$fcf_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_fcf_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(fcf_yield = q_fcf_ps/adjusted) %>%
select(-c(q_fcf_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = fcf_yield,
group = q_ticker)) %>%
hc_title(text = "Free Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Sales PS / Price
output$sales_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_sales_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(sales_yield = q_sales_ps/adjusted) %>%
select(-c(q_sales_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = sales_yield,
group = q_ticker)) %>%
hc_title(text = "Sales to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Inventory Turnover
output$inv_turn <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cogs","q_inventory"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(inventory_turnover = q_cogs/q_inventory) %>%
select(-c(q_cogs,q_inventory))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = inventory_turnover,
group = q_ticker)) %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
)) %>%
hc_title(text = "Inventory Turnover")
})
# Recievables Turnover
output$rec_turn <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue","q_receivables"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(receivables_turnover = q_revenue/q_receivables) %>%
select(-c(q_revenue,q_receivables))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = receivables_turnover,
group = q_ticker)) %>%
hc_title(text = "Receivables Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Asset Turnover
output$asset_turn <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue","q_assets"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(asset_turnover = q_revenue/q_assets) %>%
select(-c(q_revenue,q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = asset_turnover,
group = q_ticker)) %>%
hc_title(text = "Asset Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Current Ratio
output$curr_ratio <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_assets_curr","q_liab_curr"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(current_ratio = q_assets_curr/q_liab_curr) %>%
select(-c(q_assets_curr,q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = current_ratio,
group = q_ticker)) %>%
hc_title(text = "Current Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Cash Ratio
output$cash_ratio <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cash","q_investments","q_receivables","q_liab_curr"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(cash_ratio = (q_cash + q_investments + q_receivables)/q_liab_curr) %>%
select(-c(q_cash,q_investments,q_receivables,q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = cash_ratio,
group = q_ticker)) %>%
hc_title(text = "Cash Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Debt to Assets
output$debt_to_assets <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt","q_assets"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(debt_to_assets = q_debt/q_assets) %>%
select(-c(q_debt,q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_assets,
group = q_ticker)) %>%
hc_title(text = "Debt to Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Debt to Capital
output$debt_to_capital <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt","q_equity"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(debt_to_capital = q_debt/(q_debt + q_equity)) %>%
select(-c(q_debt,q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_capital,
group = q_ticker)) %>%
hc_title(text = "Debt to Capital") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Debt to Equity
output$debt_to_equity <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt","q_equity"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(debt_to_equity = q_debt/q_equity) %>%
select(-c(q_debt,q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_equity,
group = q_ticker)) %>%
hc_title(text = "Debt to Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Profitability Ratios
# Gross Profit Margin
output$gross_margin <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_gross_profit","q_revenue")) %>%
mutate(gross_margin = q_gross_profit/q_revenue) %>%
select(-c(q_gross_profit,q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = gross_margin,
group = q_ticker)) %>%
hc_title(text = "Gross Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Operating Profit Margin
output$operating_margin <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_oper_inc","q_revenue"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(operating_margin = q_oper_inc/q_revenue) %>%
select(-c(q_oper_inc,q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = operating_margin,
group = q_ticker)) %>%
hc_title(text = "Operating Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Net Profit Margin
output$profit_margin <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc","q_revenue"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(profit_margin = q_net_inc/q_revenue) %>%
select(-c(q_net_inc,q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = profit_margin,
group = q_ticker)) %>%
hc_title(text = "Profit Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# ROA
output$return_on_assets <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc","q_assets"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(return_on_assets = q_net_inc/q_assets) %>%
select(-c(q_net_inc,q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_assets,
group = q_ticker)) %>%
hc_title(text = "Return on Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# ROE
output$return_on_equity <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc","q_equity"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(return_on_equity = q_net_inc/q_equity) %>%
select(-c(q_net_inc,q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_equity,
group = q_ticker)) %>%
hc_title(text = "Return on Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Technical Indicators------------------------------------------------
tech_price <- reactive({
req(input$ticker_1)
req(input$tech_date_range)
tq_get(input$ticker_1, from = input$tech_date_range[[1]] %m-% years(1),
to = input$tech_date_range[[2]])
})
# SMA(x, n = 10, ...)
output$ind_sma <- renderHighchart({
req(input$sma_one)
req(input$sma_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_one, col_rename = "sma_50") %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_two, col_rename = "sma_200") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
sma_one_name <- paste0(input$sma_one," MA")
sma_two_name <- paste0(input$sma_two," MA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$sma_50, yAxis = 0, name = sma_one_name) %>%
hc_add_series(ind_xts$sma_200,yAxis = 0, name = sma_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
# EMA(x, n = 10, wilder = FALSE, ratio = NULL, ...)
output$ind_ema <- renderHighchart({
req(input$ema_one)
req(input$ema_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_one,col_rename = "ema_20") %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_two, col_rename = "ema_50") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
ema_one_name <- paste0(input$ema_one," EMA")
ema_two_name <- paste0(input$ema_two," EMA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$ema_20, yAxis = 0, name = ema_one_name) %>%
hc_add_series(ind_xts$ema_50,yAxis = 0, name = ema_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_macd <- renderHighchart({
req(input$macd_nfast)
req(input$macd_nslow)
req(input$macd_nsig)
# MACD(x, nFast = 12, nSlow = 26, nSig = 9, maType, percent = TRUE, ...)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = MACD,
nFast = input$macd_nfast,
nSlow = input$macd_nslow,
nSig = input$macd_nsig) %>%
mutate(diff = macd - signal) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$macd, color = "blue", yAxis = 1, name = "MACD") %>%
hc_add_series(ind_xts$signal, color = "green", yAxis = 1, name = "Signal") %>%
hc_add_series(ind_xts$diff, color = "gray", yAxis = 1, type = "column", name = "Difference") %>%
hc_tooltip(valueDecimals = "2")
})
# stoch(HLC, nFastK = 14, nFastD = 3, nSlowD = 3, maType, bounded = TRUE, smooth = 1, ...)
# aapl %>% tq_mutate(select = c(high,low,close), mutate_fun = stoch)
output$ind_stoch <- renderHighchart({
req(input$stoch_fastk)
req(input$stoch_fastd)
req(input$stoch_slowd)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = stoch,
nFastK= input$stoch_fastk,
nFastD = input$stoch_fastd,
nSlowD = input$stoch_slowd) %>%
mutate(stoch = stoch *100,
lower_level = 20,
upper_level = 80) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$stoch, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# RSI(price, n=14, maType="WMA", wts=ttrc[,"Volume"])
# aapl %>% tq_mutate(select = adjusted, mutate_fun = RSI)
output$ind_rsi <- renderHighchart({
req(input$rsi_n)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = RSI,
n = input$rsi_n) %>%
mutate(lower_level = 30,
upper_level = 70) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$rsi, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# CCI(HLC, n = 20, maType, c = 0.015, ...)
output$ind_cci <- renderHighchart({
req(input$cci_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = CCI,
n = input$cci_n) %>%
mutate(lower_level = -100,
upper_level = 100) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$cci, color = "blue", yAxis = 1, name = "CCI") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, name = "Oversold",
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, name = "Overbought", tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# aroon(HL, n = 20)
# aapl %>% tq_mutate(select = c(high,low), mutate_fun = aroon)
output$ind_aroon <- renderHighchart({
req(input$aroon_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low), mutate_fun = aroon,
n = input$aroon_n) %>%
filter(date >= input$tech_date_range[[1]]) %>%
mutate(lower_level = -100,
upper_level = 100)
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$aroonUp, color = "green", yAxis = 1, name = "Up") %>%
hc_add_series(ind_xts$aroonDn, color = "red", yAxis = 1, name = "Down" ) %>%
hc_add_series(ind_xts$oscillator, color = "blue", yAxis = 2, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "black",yAxis = 2,
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 2, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# OBV(price, volume)
output$ind_obv <- renderHighchart({
ind_df <- tech_price() %>%
tq_mutate_xy(adjusted,volume, mutate_fun = OBV) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$obv, color = "blue", yAxis = 1, name = "On Balance Volume") %>%
hc_tooltip(valueDecimals = "2")
})
# Need to Join Seperately
# ADX(HLC, n = 14, maType, ...)
output$ind_adx <- renderHighchart({
req(input$adx_n)
ind_df <- tech_price() %>% tq_transmute(select = c(high,low,close), mutate_fun = ADX, n = input$adx_n) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$DIp, color = "green", yAxis = 1, name = "Positive") %>%
hc_add_series(ind_xts$DIn, color = "red", yAxis = 1, name = "Negative") %>%
hc_add_series(ind_xts$ADX, color = "black", yAxis = 2, name = "ADX") %>%
hc_add_series(ind_xts$DX, color = "blue", yAxis = 2, name = "DX") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_bbands <- renderHighchart({
req(input$bbands_n)
req(input$bbands_sd)
# BBands(HLC, n = 20, maType, sd = 2, ...)
ind_df <- tech_price() %>% tq_transmute(select = adjusted,
mutate_fun = BBands,
n= input$bbands_n,
sd= input$bbands_sd) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
mutate(upper_level = 1,
lower_level = 0) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$dn, color = "green", yAxis = 0, name = "Lower") %>%
hc_add_series(ind_xts$up, color = "red", yAxis = 0, name = "Upper") %>%
hc_add_series(ind_xts$mavg, color = "black", yAxis = 0, name = "Moving Average") %>%
hc_add_series(ind_xts$pctB, color = "blue", yAxis = 1, name = "% B") %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$lower_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_tooltip(valueDecimals = "2")
})
# Pricing Data------------------
q_pricing <- reactive({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
tq_get(input$ticker_1,
from = input$price_date_range[[1]],
to = input$price_date_range[[2]])
# df <- q_price(ticker,
# start_date = input$price_date_range[[1]],
# end_date = input$price_date_range[[2]],
# frequency = input$price_freq) %>%
# select(q_ticker,
# date,
# adjOpen,
# adjLow,
# adjHigh,
# adjClose,
# adjVolume,
# divCash,
# splitFactor)
#
# df
})
# Pricing Chart------------------------
output$price_chart <- renderHighchart({
price_dt <- q_pricing()
price_xts <- xts(price_dt[-1],price_dt$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(price_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(price_xts$volume, yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$pricing_dt <- renderRHandsontable({
q_pricing() %>%
arrange(desc(date)) %>%
rhandsontable(stretchH = "all")
})
output$div_plot <- renderPlotly({
req(input$ticker_1)
divs <- tq_get(input$ticker_1,
get = "dividends")
if("dividends" %in% colnames(divs)){
divs %>%
plot_ly(x = ~date,
y = ~dividends,
type = 'scatter',
mode = 'lines',
fill = 'tozeroy') %>%
layout(title = paste0(input$ticker_1," Dividends Over Time"),
plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
}
})
# Returns Data -----------------------------------
output$returns_dt <- renderText({
req(input$ticker_1)
req(input$returns_benchmark)
ticker <- as.character(input$ticker_1)
benchmark <- as.character(input$returns_benchmark)
q_return_stats_full(ticker,
benchmark,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]])
})
# Performance Chart-----------------------------
output$performance_chart <- renderPlotly({
req(input$ticker_1)
req(input$returns_benchmark)
ticks <- c(input$ticker_1,input$returns_benchmark)
# plot -----------------------
plot.df <- q_price(ticks,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]],
frequency = input$returns_freq)%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = input$returns_freq,
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,input$returns_freq," Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = "")) %>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
# Key Returns --------------------
output$key_returns <- renderDataTable({
req(input$ticker_1)
req(input$returns_benchmark)
tick_key_rets <- q_key_returns(input$ticker_1)
bench_key_rets <- q_key_returns(input$returns_benchmark)
tick_key_rets %>%
full_join(bench_key_rets) %>%
DT::datatable(rownames=F,options = list(dom = "t")) %>%
formatPercentage(2:11)
})
# Calendar Returns------------------
output$calendar_returns <- renderDataTable({
req(input$ticker_1)
cal_returns<- q_return(input$ticker_1,frequency = "monthly")
nms <- tibble(
mnth_abbrev = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"),
mnth = c(1,2,3,4,5,6,7,8,9,10,11,12))
cal_returns %>%
select(date,monthly_return) %>%
mutate(mnth = month(date),
year = year(date)) %>%
left_join(nms,by = "mnth") %>%
select(-date,-mnth) %>%
spread(mnth_abbrev,monthly_return) %>%
select(year,nms$mnth_abbrev) %>%
arrange(desc(year)) %>%
DT::datatable(rownames=F, options = list(dom = 'tp')) %>%
formatPercentage(nms$mnth_abbrev,1)
})
company_news <-reactive({
req(input$ticker_1)
q_news(input$ticker_1,
sources = input$news_sources)
})
output$news_bub <- renderBubbles({
company_news <- company_news()
company_news %>%
select(tickers) %>%
unnest() %>%
count(tickers) %>%
filter(tickers != str_to_lower(input$ticker_1)) %>%
mutate(tickers = str_to_upper(tickers)) %>%
arrange(desc(n)) %>%
slice(1:5) %>%
mutate(color = rep_len(tol12qualitative,5)) %>%
bubbles::bubbles(value = .$n,
label = .$tickers,
tooltip = .$n,
color = .$color,
textColor = "white")
# mutate(color = rep_len(brewer.pal(8,"Dark2"),15)) %>%
# bubbles::bubbles(value = .$n,label = .$tickers,
# color = .$color)
})
output$news_cloud <- renderWordcloud2({
req(input$ticker_1)
company_news <- company_news()
company_descrip <- company_news %>%
pull(description)
descrip_df <- tibble(line = 1:length(company_descrip), text = company_descrip)
text_count <- descrip_df %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
sent <- text_count %>%
inner_join(get_sentiments(input$news_lex)) %>%
count(word) %>%
rename(freq = n)
descrip_df <- descrip_df %>%
unnest_tokens(word,text) %>%
count(word) %>%
anti_join(stop_words) %>%
arrange(desc(n)) %>%
rename(freq = n)
if(input$sent_filt){
# Wordcloud
sent %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
} else{
descrip_df %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
}
})
# News DT--------------------
output$news_dtt <- DT::renderDataTable({
req(input$ticker_1)
company_news <- company_news()
company_news <- company_news %>%
dplyr::select(title,description,source,published_date,url) %>%
mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
dplyr::select(-url)
dt <- company_news %>%
DT::datatable(rownames = F,selection = 'single',
escape = F,
class = 'cell-border stripe',
options = list(
columnDefs = list(
list(width = '300px', targets = c(0,1)),
list(width = '100px', targets = c(2,3)),
list(height = '100px', targets = "_all"),
list(className = 'dt-center',targets = c(2,3)),
list(className = 'dt-right',targets = 0))))
dt %>% formatDate(4,'toUTCString') %>%
DT::formatStyle(columns = 1, fontSize = '20px')
})
# tr_script <- reactive({
# q_transcript(input$ticker_1)
#
#
# })
#
#
#
# # Filings ---------------------------------
# output$transcript <- renderDataTable({
# library(rebus)
# req(input$ticker_1)
#
#
# tp <- tr_script() %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title)
#
# tp %>%
# DT::datatable(escape = F, rownames = F,
# options = list(pageLength = 20,
# columnDefs = list(list(className = 'dt-center',targets = "_all"))))
#
#
# })
# output$tr_df <- renderDataTable({
#
# library(rebus)
# t <- t_script
#
# t <- t %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title) %>% datatable(escape = F)
#
# t
#
# })
text_df <- reactive({
req(input$ticker_1)
t_script <- q_transcript(input$ticker_1)
t_ext <- t_script %>%
slice(1) %>%
pull(link) %>%
read_html() %>%
html_nodes("p") %>%
html_text()
data_frame(line = 1:length(t_ext), text = t_ext)
})
sent <- reactive({
text_count <- text_df() %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
text_count %>%
inner_join(get_sentiments("loughran"))
})
output$word_cloud <- renderWordcloud2({
# sent() %>%
# count(word, sentiment, sort = TRUE) %>%
# acast(word ~ sentiment, value.var = "n", fill = 0) %>%
# comparison.cloud(colors=rev(brewer.pal(3,"Dark2")[1:2]),
# max.words = 50)
sent() %>% count(word) %>% rename(freq = n) %>% wordcloud2(size=1.3,
backgroundColor = 'rgb(236,240,245)')
})
output$sent_chart <- renderPlotly({
gg <- sent() %>%
filter(sentiment != "superfluous", sentiment != "constraining") %>%
filter(!str_detect(word,"question")) %>%
count(word,sentiment,sort = T) %>%
group_by(sentiment) %>%
slice(1:5) %>%
ungroup() %>%
# mutate(n = ifelse(sentiment=="negative",-n,n)) %>%
mutate(word = str_to_title(word)) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free") +
labs(y = NULL,
x = NULL) +
coord_flip()+
theme_minimal()
# Sentiment Plotly
ggplotly(gg)%>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
output$some_text <- renderText({
if(!is.null(input$search) & input$search != ""){
text_df <- text_df() %>%
filter(str_detect(text,input$search)) %>%
mutate(text = str_replace_all(text,input$search,paste0("<mark>",input$search,"</mark>")))
t_script <- paste(text_df$text,collapse="<br><br>")
} else {
text_df <- text_df()
t_script <- paste(text_df$text,collapse="<br><br>")
}
paste0("<h4>",t_script,"</h4>")
})
output$ten_k_q_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$ten_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$eight_k_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$eight_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$prospectus_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$pros_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$proxy_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$proxy_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$thirteen_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$thirteen_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
}))
zac-garland/equityresearch documentation built on July 30, 2020, 2:29 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
options(shiny.autoreload = TRUE)
# Header ------------------------------------------------
header <- dashboardHeader(title = shiny::tags$a(shiny::tags$img(src = "logo_r_equity_research.svg",width = "200",height = "31")))
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(
sidebarSearchForm(textId = "ticker_1", buttonId = "searchButton",
label = "Ticker..." ),
sidebarMenu(id = 'sidebarmenu',
# Equity Overview -------------------------
menuItem('Watchlist',
tabName = 'overview',
icon = icon('dedent'),
menuSubItem("Watchlist",
tabName = 'watchlist')
),
# News--------------------
menuItem('Equity Overview (beta)',
tabName = 'news',
icon = icon('newspaper-o'),
menuSubItem("Overview",
tabName = "news_dt"),
conditionalPanel("input.sidebarmenu === 'news_dt'",
selectizeInput(inputId = 'news_sources',
label = 'News Sources',
choices = c("Seeking Alpha" = "seekingalpha.com",
"The Motley Fool" = "fool.com",
"Market Watch" = "marketwatch.com",
"CNBC" = "cnbc.com",
"Reuters" = "reuters.com",
"Nasdaq" = "nasdaq.com",
"Bloomberg" = "bloomberg.com",
"Yahoo Finance" = "finance.yahoo.com",
"Zacks" = "zacks.com",
"Wall Street Journal" = "wsj.com",
"Barrons" = "barrons.com"),
multiple = TRUE,
selected = NULL),
selectInput("news_lex",
"Lexicon:",
choices = c("NRC" = "nrc",
"Bing" = "bing",
"AFINN" = "afinn",
"Loughran" = "loughran")),
checkboxInput(inputId = "sent_filt",value = FALSE,
label = "Use Lexicon")
)),
# Filings------------------------------
menuItem('Filings',
tabName = 'Filings',
icon = icon('file'),
menuSubItem("Transcripts",
tabName = "tra_script"),
# conditionalPanel("input.sidebarmenu === 'tra_script'",
# textInput("search", "Search")),
menuSubItem("10-K's and Q's",
tabName = "ten_k_q"),
menuSubItem("8-K",
tabName = "eight_k"),
menuSubItem("Prospectus'",
tabName = "prospectus"),
menuSubItem("Proxy Statements",
tabName = "proxy"),
menuSubItem("Beneficial Ownership",
tabName = "thirteen")),
# Technical Indicators--------------------
menuItem("Technical Indicators",
tabName = 'tech_chart',
icon = icon('random'),
dateRangeInput("tech_date_range",
"Date range:",
start = Sys.Date() %m-% years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
menuSubItem("RSI","tab_ind_rsi"),
menuSubItem("MACD","tab_ind_macd"),
menuSubItem("Bollinger Bands","tab_ind_bbands"),
menuSubItem("Stochastic Oscillator","tab_ind_stoch"),
menuSubItem("Commondity Channel Index","tab_ind_cci"),
menuSubItem("AROON","tab_ind_aroon"),
menuSubItem("On Balance Volume","tab_ind_obv"),
menuSubItem("ADX","tab_ind_adx"),
menuSubItem("Simple MA","tab_ind_sma"),
menuSubItem("Exponential MA", "tab_ind_ema"),
conditionalPanel("input.sidebarmenu === 'tab_ind_rsi'",
numericInput("rsi_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_macd'",
numericInput("macd_nfast","Fast:",value = 12),
numericInput("macd_nslow","Slow:",value = 26),
numericInput("macd_nsig","Signal:",value = 9)),
conditionalPanel("input.sidebarmenu === 'tab_ind_bbands'",
numericInput("bbands_n","Periods:",value = 20),
numericInput("bbands_sd", "Std Dev:", value = 2)),
conditionalPanel("input.sidebarmenu === 'tab_ind_stoch'",
numericInput("stoch_fastk","Fast K:",value = 14),
numericInput("stoch_fastd", "Fast D",value = 3),
numericInput("stoch_slowd","Slow D",value = 3)),
conditionalPanel("input.sidebarmenu === 'tab_ind_cci'",
numericInput("cci_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_aroon'",
numericInput("aroon_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_adx'",
numericInput("adx_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_sma'",
numericInput("sma_one","Periods:",value = 50),
numericInput("sma_two","Periods:",value = 200)),
conditionalPanel("input.sidebarmenu === 'tab_ind_ema'",
numericInput("ema_one","Periods:",value = 20),
numericInput("ema_two","Periods:",value = 50))
),
# Pricing Data-----------------------
menuItem('Prices, Risk, & Returns',
tabName = 'pricing_data',
icon = icon('line-chart'),
# Returns Data --------------------
menuSubItem('Risk & Returns Data',
tabName = 'returns_data'),
conditionalPanel("input.sidebarmenu === 'returns_data'",
textInput("returns_benchmark",
label = "Benchmark",
value = "SPY"),
dateRangeInput("returns_date_range",
"Date range:",
start = Sys.Date() - years(2),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
selectInput("returns_freq", "Chart Frequency:",
c("Daily" = "daily",
"Monthly" = "monthly",
"Yearly" = "yearly"),"daily")
),
menuSubItem("Pricing Data",
tabName = 'price_data'),
conditionalPanel("input.sidebarmenu === 'price_data'",
dateRangeInput("price_date_range",
"Date range:",
start = Sys.Date() - years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date())
)
)
))
# Body ------------------------------------------------
body <- dashboardBody(shiny::tags$script(HTML("$('body').addClass('sidebar-mini');")),
# shiny::tags$style(HTML("")),
shiny::tags$style(".nav-tabs {background: #f4f4f4;}
.nav-tabs-custom .nav-tabs li.active:hover a, .nav-tabs
custom .nav-tabs li.active a {background-color: transparent;
border-color: transparent;
}
.nav-tabs-custom .nav-tabs li.active {border-top-color:
#314a6d;
}
"
),
# tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "add-on.css")),
# Equity Overview ----------------------------------
tabItems(
tabItem(tabName = "watchlist",
fluidRow(
column(6,
shinydashboard::box(id = "tabset_watch",
height = "550px",
width = 12,
withSpinner(dataTableOutput("watchlist_dt"))
)),
column(6,
tabBox(id = "tabset_2",
height = "550px",
width = 12,
tabPanel("Top % Chg",
br(),
br(),
withSpinner(plotlyOutput("top_btm_chart"))),
tabPanel("News",
withSpinner(uiOutput("watchlist_news_dt"))),
tabPanel("Return Stats",
fluidRow(column(1),
column(5,
br(),
withSpinner(htmlOutput("return_stats_one"))),
# column(1),
column(6,
br(),
withSpinner(htmlOutput("return_stats_two"))))
# , output
),
tabPanel("Relative Perf",
withSpinner(plotlyOutput("ret_perf"))),
tabPanel("Key Stats",
br(),
br(),
withSpinner(dataTableOutput("key_stats")))
))
),
fluidRow(
column(12,
shinydashboard::box(id = "watchlist_4",
height = "750px",
width = 12,
withSpinner(dataTableOutput("filing_short")))
))
),
tabItem(tabName = "equity_overview",
fluidRow(column(7,h2(textOutput("company_name")))),
fluidRow(column(2,h2(textOutput("current_price"))),
column(1,h2(htmlOutput("price_chg"))),
column(2, h2(htmlOutput("pct_chg"))),
column(3,h3(textOutput("as_of"))),
column(2,h3(textOutput("currency_in")))),
fluidRow(column(12,withSpinner(highchartOutput("stock_chart")))),
fluidRow(column(12,dataTableOutput("equity_stats")))
),
# Technical Indicators---------------
tabItem(tabName = "tab_ind_sma",
fluidRow(column(12, withSpinner(highchartOutput("ind_sma", height = "850px"))))),
tabItem(tabName = "tab_ind_ema",
fluidRow(column(12, withSpinner(highchartOutput("ind_ema", height = "850px"))))),
tabItem(tabName = "tab_ind_macd",
fluidRow(column(12, withSpinner(highchartOutput("ind_macd", height = "850px"))))),
tabItem(tabName = "tab_ind_stoch",
fluidRow(column(12, withSpinner(highchartOutput("ind_stoch", height = "850px"))))),
tabItem(tabName = "tab_ind_rsi",
fluidRow(column(12, withSpinner(highchartOutput("ind_rsi", height = "850px"))))),
tabItem(tabName = "tab_ind_cci",
fluidRow(column(12, withSpinner(highchartOutput("ind_cci", height = "850px"))))),
tabItem(tabName = "tab_ind_aroon",
fluidRow(column(12, withSpinner(highchartOutput("ind_aroon", height = "850px"))))),
tabItem(tabName = "tab_ind_obv",
fluidRow(column(12, withSpinner(highchartOutput("ind_obv", height = "850px"))))),
tabItem(tabName = "tab_ind_adx",
fluidRow(column(12, withSpinner(highchartOutput("ind_adx", height = "850px"))))),
tabItem(tabName = "tab_ind_bbands",
fluidRow(column(12, withSpinner(highchartOutput("ind_bbands", height = "850px"))))),
# Pricing Data ----------------------------------
tabItem(tabName = "price_data",
fluidRow(column(12,withSpinner(highchartOutput("price_chart")))),
half_row(rHandsontableOutput("pricing_dt", height = "600px"),
plotlyOutput("div_plot", height = "600px"))
),
# Returns Data ----------------------------------
tabItem(tabName = "returns_data",
withSpinner(fluidRow(column(2,br(),htmlOutput("returns_dt")),
column(10,
DTOutput("key_returns"),
br(),
plotlyOutput("performance_chart"),
br(),
DTOutput("calendar_returns"))))
),
# News-------------------------------------------
tabItem(tabName = "news_dt",
fluidRow(column(6,h2(textOutput("title_1")),
withSpinner(dataTableOutput("key_info"))),
column(6,
h2(textOutput("title_3")),
br(),
withSpinner(htmlOutput("descrip")))
),
fluidRow(column(7,h2(textOutput("title_4")),
br(),br(),br(),wordcloud2Output("news_cloud",width="100%"))),
fluidRow(column(12,withSpinner(DT::DTOutput("news_dtt"))))
),
# Portfolio Optimization----------------------------
tabItem(tabName = "tab_markowitz_optimization",
fluidRow(column(12,plotlyOutput("markowitz_optimization", height = "850px")))),
tabItem(tabName = "tab_backtesting_mo",
fluidRow(column(12,plotlyOutput("backtesting_mo", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier",
fluidRow(column(12,plotlyOutput("efficient_frontier", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier_constraints",
fluidRow(column(12,plotlyOutput("efficient_frontier_constraints", height = "850px")))),
tabItem(tabName = "tab_portfolio_analytics",
fluidRow(column(6,plotlyOutput("portfolio_analytics_min_sd", height = "850px")),
column(6,plotlyOutput("portfolio_analytics_min_es", height = "850px")))),
tabItem(tabName = "tab_compare_risk",
fluidRow(column(12,plotlyOutput("compare_risk_measures", height = "850px")))),
tabItem(tabName = "tab_active_extension",
fluidRow(column(12,plotlyOutput("active_extension", height = "850px")))),
# Filings -----------------------------------
tabItem(tabName = "tra_script",
full_row(wordcloud2Output("word_cloud",height = "500px")),
# half_row(dataTableOutput("tr_df"),plotlyOutput("sent_chart", height ="auto")),
# full_row(),
full_row(br()),
full_row(br()),
full_row(plotlyOutput("sent_chart", height ="500px", width = "100%")),
full_row(br()),
full_row(br()),
# full_row(),
full_row(textInput("search", "Search")),
full_row(htmlOutput("some_text"))
),
tabItem(tabName = "ten_k_q",
full_row(withSpinner(plotlyOutput("ten_k_plot"))),
fluidRow(column(12,dataTableOutput("ten_k_q_table")))
),
tabItem(tabName = "eight_k",
full_row(withSpinner(plotlyOutput("eight_k_plot"))),
fluidRow(column(12,dataTableOutput("eight_k_table")))
),
tabItem(tabName = "prospectus",
full_row(withSpinner(plotlyOutput("pros_plot"))),
fluidRow(column(12,dataTableOutput("prospectus_table")))
),
tabItem(tabName = "proxy",
full_row(withSpinner(plotlyOutput("proxy_plot"))),
fluidRow(column(12,dataTableOutput("proxy_table")))
),
tabItem(tabName = "thirteen",
full_row(withSpinner(plotlyOutput("thirteen_plot"))),
fluidRow(column(12,dataTableOutput("thirteen_table")))
),
# Screening---------------------------------------------
tabItem(
tabName = "constits",
fluidRow(class = "text-center",column(12,h3(textOutput("index_name")))),
half_row(br(),br()),
half_row(withSpinner(highchartOutput("index_tree")),
withSpinner(plotlyOutput("index_top"))),
full_row(br()),
full_row(withSpinner(dataTableOutput("index_screen")))
),
tabItem(
tabName = "screen",
fluidRow(
tabBox(id = "screen_tab_box",
width = 12,
tabPanel("Screen",
fluidRow(column(3,rHandsontableOutput("hot_three")),
column(9,withSpinner(rHandsontableOutput("filtered_results_r",
height = "900px"))))),
tabPanel("Visualize",
full_row(uiOutput("hist_select")),
half_row(withSpinner(plotlyOutput("screen_box")),withSpinner(plotlyOutput("screen_hist"))),
half_row(br(),br()),
fluidRow(column(6,plotlyOutput("screen_perf")),
column(6,highchartOutput("screen_tree"))))
))
),
tabItem(
tabName = "hc",
tabBox(id = "hc_tab",
width = 12,
tabPanel("Cluster Cor",
full_row(withSpinner(rHandsontableOutput("cor_mx", height = "1500px")))),
tabPanel("Risk / Returns",
fluidRow(column(2,br(),withSpinner(htmlOutput("clust_returns_dt"))),
column(10,
withSpinner(highchartOutput("clust_tree")),
br(),
withSpinner(plotlyOutput("ret_filt"))))
),
tabPanel("Current Screen",
full_row(withSpinner(rHandsontableOutput("clust_screen", height = "900px")))))
#
# fluidRow(column(12,withSpinner(rHandsontableOutput("cor_mx", height ="900px")))),
#
# # full_row(rHandsontableOutput("cor_mx")),
# full_row(plotlyOutput("ret_filt"))
)
))
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(title = "Equity Research",
header,
sidebar,
body,
skin = "black"
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){
# Watchlist Script------------------------------------------------
output$polar_chart <- renderPlotly({
plot_ly(type = 'scatterpolar',
fill = 'toself') %>%
add_trace(
r = c(25,25,25,0,0,0),
theta = c("Consulting","Education","Analyst","Asset Management","Coding","Data Science"),
name = 'Experience',
fillcolor = 'rgba(55, 128, 191, 0.5)',
marker = list(color = "black")
) %>%
add_trace(
r = c(0,0,25,25,25,25),
theta = c("Consulting","Education","Analyst","Asset Management","Coding","Data Science"),
name = 'Capstone',
fillcolor = 'rgba(50, 171, 96, 0.5)',
marker = list(color = "black")
) %>%
layout(polar = list(radialaxis = list(visible = T,
range = c(0,50))),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$ideal_map <- renderHighchart({
ideal_location()
})
output$invest_style <- renderPlotly({
my_style %>%
# group_by(category) %>%
arrange(desc(value)) %>%
mutate(name = as_factor(name)) %>%
# mutate(row_n = 1:nrow(.)) %>% arrange(desc(row_n)) %>%
# arrange(order) %>%
# mutate(category = fct_reorder(category,order)) %>%
plot_ly(x = ~value,
y = ~category,
# sort = F,
type = "bar",
color = ~value,
colors = 'Blues',
# marker = list(color = ~color),
orientation = "h",
name = ~name) %>%
layout(yaxis = list(title = ''),
xaxis = list(title = ''),
barmode = 'stack') %>%
hide_colorbar() %>%
layout(legend = list(orientation = 'h', y = -0.1),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$watchlist_dt <- renderDataTable({
q_quotes %>%
arrange(desc(pct_chg)) %>%
mutate(green_red = as.numeric(ifelse(chg>0,1,0))) %>%
datatable(rownames = F,
selection = 'single',
options = list(scrollX = TRUE,
columnDefs = list(list(targets = 9, visible = FALSE))
)) %>%
formatPercentage("pct_chg",2) %>%
formatStyle(c('pct_chg'),'green_red',
backgroundColor = styleEqual(c(1, 0), c('rgba(50, 171, 96, 0.5)', 'rgba(219, 64, 82, 0.5)')))
})
output$top_btm_chart <- renderPlotly({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to Compare Performance"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_quotes <- q_quotes %>%
mutate(rank = min_rank(desc(pct_chg))) %>% filter(rank <= 5 | rank >= (max(rank,na.rm=T)-5)) %>% select(-rank)
q_quotes %>%
arrange(pct_chg) %>%
mutate(color = ifelse(pct_chg>0,'rgba(50, 171, 96, 0.7)', 'rgba(219, 64, 82, 0.7)')) %>%
mutate(symbol = as_factor(symbol)) %>%
plot_ly(x = ~pct_chg,
y = ~symbol,
type = 'bar',
orientation = 'h',
marker = list(color = ~color)) %>%
add_annotations(x = q_quotes$pct_chg/2,
y = q_quotes$symbol,
text = q_quotes$symbol,
xref = "x",
yref = "y",
showarrow = F,
font = list(color = '#ffffff',
family = 'sans serif',
size = 20)) %>%
layout(xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
zeroline = F,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE),
showlegend = F)
})
# output$watchlist_news_dt <- DT::renderDataTable({
#
# validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Company News"))
# req(input$watchlist_dt_rows_selected)
#
# # s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
# s <- input$watchlist_dt_rows_selected
#
# ticker <- q_quotes %>%
# arrange(desc(pct_chg)) %>%
# .[[s,1]]
#
#
# company_news <- q_news(ticker) %>%
# dplyr::select(title,description,source,published_date,url) %>%
# dplyr::mutate(description = ifelse(str_length(description)>=350,
# paste0(str_sub(description,1,350),
# "..."),
# description)) %>%
# mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
# source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
# dplyr::select(-url,-description)
#
#
# dt <- company_news %>%
# DT::datatable(rownames = F,selection = 'single',
# escape = F,
# class = 'cell-border stripe',
# extensions = c('ColReorder','Scroller'),
# options = list(colReorder = TRUE,
# deferRender = T,
# pageLength = 5))
#
#
# dt %>% formatDate(4,'toUTCString') %>%
# DT::formatStyle(columns = 1, fontSize = '20px')
#
#
#
#
# })
output$watchlist_news_dt <- renderUI({
test <- function(title,link,date,descrip){
shiny::HTML(paste0('
<div class="row">
<h3><a href=',link,'>',title,' </a></h3>
<span>',date,'</span>
<br>
</div>
<div class="row">
',descrip,'
</div>
'))
}
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Company News"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_news(ticker) %>%
rowid_to_column() %>%
split(.$rowid) %>%
map(~{
test(
title = .$item_title,
link = .$item_link,
date = .$item_date_published,
descrip = .$item_description %>% str_sub(1,500)
)
}) %>%
shiny::div(style="overflow-y: scroll;height:400px;")
})
output$return_stats_one <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_one(ticker,"SPY")
})
output$return_stats_two <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_two(ticker,"SPY")
})
# Performance Chart-----------------------------
output$ret_perf <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
ticks <- c(ticker,"SPY")
# plot -----------------------
plot.df <- q_price(ticks,
start_date = Sys.Date() - years(2),
frequency = "daily")%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = "daily",
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,"Daily Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = ""))
})
output$key_stats <- renderDataTable({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Key Stats"))
# Yahoooo Key Stats
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- q_key_stats(ticker)
DT::datatable(df,
colnames = c("","","",""),
rownames = FALSE,
selection = 'none', options = list(dom = 't',
bSort=FALSE,
columnDefs = list(
list(className = 'dt-right', targets = c(1,3)))))
})
output$sm_eq_inc_dt <- renderText({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Financials"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_inc_fmt_tbl(ticker,n = 3)
})
# Assets Sub Plot---------------------------------------------
output$sm_eq_assets_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_bal_fmt_tbl(ticker,n = 3)
})
output$sm_eq_liab_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_bal_fmt_tbl(ticker,
selection = "liab",
n = 3)
})
output$sm_eq_equity_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_bal_fmt_tbl(ticker,
selection = "equity",
n = 3)
})
output$sm_eq_cf_dt <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_cf_fmt_tbl(ticker,
n = 3)
})
output$filing_short <- renderDataTable({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
filings <- company_filings(ticker , count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$own_pie <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- Quandl.datatable("SHARADAR/SF3", ticker = ticker,
paginate = T, securitytype = "SHR",
calendardate.gte=as.character(Sys.Date()-days(180))) %>%
filter(calendardate == max(calendardate)) %>%
select(-c(ticker,securitytype)) %>%
as_tibble()
all_sh_sum <- sum(df$value)
inst_data <- df %>%
mutate(top_5 = ifelse(min_rank(desc(value))<= 5, investorname,"OTHER")) %>%
group_by(top_5) %>%
summarize(pct_by_group = sum(value,na.rm = T)/all_sh_sum) %>%
mutate(lev = ifelse(top_5 == "Other",dplyr::n()+1,min_rank(desc(pct_by_group)))) %>%
arrange(lev) %>%
mutate(top_5 = factor(top_5,unique(top_5)))
inst_data %>%
plot_ly(labels = ~top_5,
values = ~pct_by_group,
type = 'pie')
})
# Equity Overview Script ----------------------------------------
output$title_1 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Info")
})
output$title_3 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Description")
})
output$title_4 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Frequent News Buzzwords")
})
output$key_info <- renderDataTable({
req(input$ticker_1)
key_info <- Quandl.datatable("SHARADAR/TICKERS",ticker = input$ticker_1) %>%
filter(table == "SF1") %>%
select(ticker,name,exchange,sicsector,sicindustry,location,secfilings,companysite) %>%
rename(sector = sicsector,
industry = sicindustry) %>%
gather(key,value)
key_info %>%
bind_cols(q_key_stats(input$ticker_1)) %>%
mutate(value = ifelse(key %in% c("secfilings","companysite"),
paste0("<a href='",value,"' target='_blank'>","Link","</a>"),
value)) %>%
mutate(key = str_to_title(key)) %>%
as_tibble() %>%
datatable(rownames = F,
colnames=c("", "","","","",""),
escape = F,
options = list(dom = 't',ordering=F))
})
output$descrip <- renderText({
req(input$ticker_1)
paste0("<h4>",q_descrip(input$ticker_1),"</h4>")
# descrip <- descrip %>%
# str_split(" ") %>%
# as_vector() %>%
# tibble(word = .) %>%
# mutate(word = ifelse(!(word %in% stop_words$word),
# paste0("<b>",word,"</b>"),
# paste0('<font color = "#ECF0F5">',word,"</font>"))) %>%
# pull(word) %>%
# paste(sep = " ",collapse = " ")
#
# paste0("<h4>",descrip,"</h4>")
# %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# inner_join(sentiments) %>%
# distinct(word) %>%
# mutate(word = paste(word,"<br>")) %>%
# pull()
# descrip %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# pull(word) %>%
# paste(sep = "",collapse = "")
# as.vector(strsplit(descrip, '\\. ')) %>%
# tibble(word = .) %>%
# unnest(word) %>%
# mutate(line = 1:nrow(.)) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# nest(word) %>%
# mutate(text = map(data,unlist),
# text = map_chr(text, paste, collapse = " "),
# text = paste(text,"<br>")) %>%
# pull(text)
})
# IS Waterfall Chart---------------------------------------------
output$waterfall_chart <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
df <- q_income_statement(ticker, dimension = paste0(input$fund_dim,input$fund_freq))
df <- df[1,]
dat_graph <- tibble(x = c('Revenue','COGS','Gross Margin','Op Ex','RND','SGA','Op Income','Other Inc','EBIT','Interest and Taxes','Net Income'),
base = c(0, df$q_gross_profit,0,df$q_oper_inc,(df$q_gross_profit - df$q_rnd), df$q_oper_inc, 0,ifelse(df$q_other_income >0,
df$q_oper_inc,
df$q_oper_inc + df$q_other_income),
0, ifelse(df$q_interest_nd_tax > 0, df$q_ebit, df$q_ebit + df$q_interest_nd_tax),0),
revenues = c(df$q_revenue,
rep(0,6),
ifelse(df$q_other_income >0 , df$q_other_income,0),
0,
ifelse(df$q_interest_nd_tax > 0, df$q_interest_nd_tax,0),
0),
costs = c(0, df$q_cogs, 0,
df$q_oper_exp,
df$q_rnd,
df$q_sgna,
0,
ifelse(df$q_other_income < 0 , -df$q_other_income,0),
0,
ifelse(df$q_interest_nd_tax < 0, -df$q_interest_nd_tax,0),
0),
profit = c(0,0,df$q_gross_profit,
rep(0,3),
df$q_oper_inc,
0,
df$q_ebit,
0, df$q_net_inc))
dat_graph <- dat_graph %>%
filter(!(x %in% c("RND","SGA"))) %>%
mutate(y = ifelse(costs == 0, sum(base,revenues,costs,profit)/2, base + (costs/2)))
#The default order will be alphabetized unless specified as below:
dat_graph$x <- factor(dat_graph$x, levels = dat_graph[["x"]])
plot_ly(dat_graph,
x = ~x,
y = ~base,
type = 'bar',
marker = list(color = 'rgba(1,1,1, 0.0)')) %>%
add_trace(y = ~revenues,
marker = list(color = 'rgba(55, 128, 191, 0.7)',
line = list(color = 'rgba(55, 128, 191, 0.7)',
width = 2))) %>%
add_trace(y = ~costs,
marker = list(color = 'rgba(219, 64, 82, 0.7)',
line = list(color = 'rgba(219, 64, 82, 1.0)',
width = 2))) %>%
add_trace(y = ~profit,
marker = list(color = 'rgba(50, 171, 96, 0.7)',
line = list(color = 'rgba(50, 171, 96, 1.0)',
width = 2))) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)',
showlegend = FALSE)
})
# Income Statement DataTable--------------------------------------------------
output$income_statement_dt <- renderText({
req(input$ticker_1)
q_inc_fmt_tbl(ticker = input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq))
})
# BS Treemap--------------------------------------------------
output$balance_sheet_treemap <- renderHighchart({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
bal_sheet <- q_balance_sheet(ticker,dimension = paste0(input$fund_dim,input$fund_freq)) %>%
dplyr::select(q_cal_date,
q_cash,
q_invest_curr,
q_receivables,
q_inventory,
q_other_curr_assets,
q_invest_non_curr,
q_ppe,
q_assets_good_intang,
q_other_non_curr_assets,
q_payables,
q_debt_curr,
q_other_curr_liab,
q_debt_non_curr,
q_other_non_curr_liab,
q_retained_earn,
q_other_equity)
# Generate Data for Treemap ---------------------
tm <- bal_sheet %>%
dplyr::filter(q_cal_date == max(q_cal_date, na.rm = T)) %>%
gather(q_lo,value, -q_cal_date) %>%
left_join(bal_sheet_tree_ref, by = "q_lo") %>%
rename(descrip = name) %>%
mutate_at("main_group", str_replace,"Equity", "Shareholders Equity") %>%
mutate(color_numeric = as.numeric(as.factor(main_group)))
# Generate Data Classes Colors------------------------------------------
data_classes <- list(list(from = 1,
to = 1,
color = "#3780bf",
name = "Assets"),
list(from = 2,
to = 2,
color = "#db4052",
name = "Liabilities"),
list(from = 3,
to = 3,
color = "#32ab60",
name = "Shareholders Equity"))
hctreemap2(tm,
group_vars = c("main_group","sub_group","descrip"),
size_var = "value",
color_var = "color_numeric",
layoutAlgorithm = "squarified") %>%
hc_colorAxis(
dataClassColor = "category",
dataClasses = data_classes
)
})
# Balance Sheet Data Tables ----------------------------
output$assets_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,dimension = paste0(input$fund_dim,input$fund_freq))
})
output$liab_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq),
selection = "liab")
})
output$equity_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq),
selection = "equity")
})
# CF Graph ---------------------------------------
output$cf_graph <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
cf_statement <- q_cash_flow_statement(ticker, dimension = paste0(input$fund_dim,input$fund_freq)) %>%
slice(1:10)
if(!is.null(input$cf_item)){
cf_statement %>%
select(q_cal_date,input$cf_item) %>%
gather(indicator,value,-q_cal_date) %>%
plot_ly(x = ~q_cal_date,
y = ~value,
color = ~indicator,
type = "bar") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
}
})
# CF Data Tables----------------------------------------
output$cf_dt <- renderText({
req(input$ticker_1)
q_cf_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim,input$fund_freq))
})
# Fundamental Indicators--------------------------------
ticker_price <- reactive({
req(input$ticker_1)
# req(input$compare_ticker)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
ticker_price <- tq_get(ticker)
if(!("symbol" %in% colnames(ticker_price))){
ticker_price <- ticker_price %>% mutate(symbol = input$ticker_1)
}
ticker_price <- ticker_price %>%
select(symbol,date,adjusted) %>%
spread(symbol,adjusted)
ticker_price <-seq.Date(min(ticker_price$date),max(ticker_price$date),by = "days") %>%
tibble(date = .) %>%
left_join(ticker_price, by = "date") %>%
fill(-date) %>%
gather(symbol,adjusted,-date)
ticker_price
})
# Earnings Yield
output$earnings_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_eps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(earnings_yield = q_eps/adjusted) %>%
select(-c(q_eps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = earnings_yield,
group = q_ticker)) %>%
hc_title(text = "Earnings Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Dividend Yield div/price
output$div_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_divs_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(dividend_yield = q_divs_ps/adjusted) %>%
select(-c(q_divs_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = dividend_yield,
group = q_ticker)) %>%
hc_title(text = "Dividend Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Book Value PS/ Price
output$book_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_bv_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(book_yield = q_bv_ps/adjusted) %>%
select(-c(q_bv_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = book_yield,
group = q_ticker)) %>%
hc_title(text = "Book to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Operating CF Yield OCF PS/Price
output$ocf_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cf_oper","q_shares"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(oper_cf_yield = (q_cf_oper/q_shares)/adjusted) %>%
select(-c(q_cf_oper,q_shares,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = oper_cf_yield,
group = q_ticker)) %>%
hc_title(text = "Operating Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# FCF Yield PS / Price
output$fcf_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_fcf_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(fcf_yield = q_fcf_ps/adjusted) %>%
select(-c(q_fcf_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = fcf_yield,
group = q_ticker)) %>%
hc_title(text = "Free Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Sales PS / Price
output$sales_yield <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_sales_ps"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
filter(q_cal_date >= min(ticker_price()$date,na.rm = T))
df <- df %>%
left_join(ticker_price(), by = c("q_ticker" = "symbol","q_cal_date" = "date")) %>%
mutate(sales_yield = q_sales_ps/adjusted) %>%
select(-c(q_sales_ps,adjusted))
hchart(df,type = "line",
hcaes( x = q_cal_date,
y = sales_yield,
group = q_ticker)) %>%
hc_title(text = "Sales to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Inventory Turnover
output$inv_turn <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cogs","q_inventory"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(inventory_turnover = q_cogs/q_inventory) %>%
select(-c(q_cogs,q_inventory))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = inventory_turnover,
group = q_ticker)) %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
)) %>%
hc_title(text = "Inventory Turnover")
})
# Recievables Turnover
output$rec_turn <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue","q_receivables"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(receivables_turnover = q_revenue/q_receivables) %>%
select(-c(q_revenue,q_receivables))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = receivables_turnover,
group = q_ticker)) %>%
hc_title(text = "Receivables Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Asset Turnover
output$asset_turn <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue","q_assets"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(asset_turnover = q_revenue/q_assets) %>%
select(-c(q_revenue,q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = asset_turnover,
group = q_ticker)) %>%
hc_title(text = "Asset Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Current Ratio
output$curr_ratio <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_assets_curr","q_liab_curr"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(current_ratio = q_assets_curr/q_liab_curr) %>%
select(-c(q_assets_curr,q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = current_ratio,
group = q_ticker)) %>%
hc_title(text = "Current Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Cash Ratio
output$cash_ratio <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cash","q_investments","q_receivables","q_liab_curr"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(cash_ratio = (q_cash + q_investments + q_receivables)/q_liab_curr) %>%
select(-c(q_cash,q_investments,q_receivables,q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = cash_ratio,
group = q_ticker)) %>%
hc_title(text = "Cash Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Debt to Assets
output$debt_to_assets <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt","q_assets"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(debt_to_assets = q_debt/q_assets) %>%
select(-c(q_debt,q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_assets,
group = q_ticker)) %>%
hc_title(text = "Debt to Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Debt to Capital
output$debt_to_capital <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt","q_equity"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(debt_to_capital = q_debt/(q_debt + q_equity)) %>%
select(-c(q_debt,q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_capital,
group = q_ticker)) %>%
hc_title(text = "Debt to Capital") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Debt to Equity
output$debt_to_equity <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt","q_equity"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(debt_to_equity = q_debt/q_equity) %>%
select(-c(q_debt,q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_equity,
group = q_ticker)) %>%
hc_title(text = "Debt to Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Profitability Ratios
# Gross Profit Margin
output$gross_margin <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_gross_profit","q_revenue")) %>%
mutate(gross_margin = q_gross_profit/q_revenue) %>%
select(-c(q_gross_profit,q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = gross_margin,
group = q_ticker)) %>%
hc_title(text = "Gross Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Operating Profit Margin
output$operating_margin <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_oper_inc","q_revenue"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(operating_margin = q_oper_inc/q_revenue) %>%
select(-c(q_oper_inc,q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = operating_margin,
group = q_ticker)) %>%
hc_title(text = "Operating Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Net Profit Margin
output$profit_margin <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc","q_revenue"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(profit_margin = q_net_inc/q_revenue) %>%
select(-c(q_net_inc,q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = profit_margin,
group = q_ticker)) %>%
hc_title(text = "Profit Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# ROA
output$return_on_assets <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc","q_assets"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(return_on_assets = q_net_inc/q_assets) %>%
select(-c(q_net_inc,q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_assets,
group = q_ticker)) %>%
hc_title(text = "Return on Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# ROE
output$return_on_equity <- renderHighchart({
req(input$ticker_1)
if(is.null(input$compare_ticker) | input$compare_ticker ==""){
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker,",") %>%
as_vector()
ticker <- c(input$ticker_1,comps)
}
df <- q_dat(ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc","q_equity"),
calendardate.gte = Sys.Date() %m-%years(10)) %>%
mutate(return_on_equity = q_net_inc/q_equity) %>%
select(-c(q_net_inc,q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_equity,
group = q_ticker)) %>%
hc_title(text = "Return on Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(type = 'year', count = 10, text = '10Y'),
list(type = 'year', count = 5, text = '5Y'),
list(type = 'year', count = 3, text = '3Y')
))
})
# Technical Indicators------------------------------------------------
tech_price <- reactive({
req(input$ticker_1)
req(input$tech_date_range)
tq_get(input$ticker_1, from = input$tech_date_range[[1]] %m-% years(1),
to = input$tech_date_range[[2]])
})
# SMA(x, n = 10, ...)
output$ind_sma <- renderHighchart({
req(input$sma_one)
req(input$sma_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_one, col_rename = "sma_50") %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_two, col_rename = "sma_200") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
sma_one_name <- paste0(input$sma_one," MA")
sma_two_name <- paste0(input$sma_two," MA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$sma_50, yAxis = 0, name = sma_one_name) %>%
hc_add_series(ind_xts$sma_200,yAxis = 0, name = sma_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
# EMA(x, n = 10, wilder = FALSE, ratio = NULL, ...)
output$ind_ema <- renderHighchart({
req(input$ema_one)
req(input$ema_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_one,col_rename = "ema_20") %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_two, col_rename = "ema_50") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
ema_one_name <- paste0(input$ema_one," EMA")
ema_two_name <- paste0(input$ema_two," EMA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$ema_20, yAxis = 0, name = ema_one_name) %>%
hc_add_series(ind_xts$ema_50,yAxis = 0, name = ema_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_macd <- renderHighchart({
req(input$macd_nfast)
req(input$macd_nslow)
req(input$macd_nsig)
# MACD(x, nFast = 12, nSlow = 26, nSig = 9, maType, percent = TRUE, ...)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = MACD,
nFast = input$macd_nfast,
nSlow = input$macd_nslow,
nSig = input$macd_nsig) %>%
mutate(diff = macd - signal) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$macd, color = "blue", yAxis = 1, name = "MACD") %>%
hc_add_series(ind_xts$signal, color = "green", yAxis = 1, name = "Signal") %>%
hc_add_series(ind_xts$diff, color = "gray", yAxis = 1, type = "column", name = "Difference") %>%
hc_tooltip(valueDecimals = "2")
})
# stoch(HLC, nFastK = 14, nFastD = 3, nSlowD = 3, maType, bounded = TRUE, smooth = 1, ...)
# aapl %>% tq_mutate(select = c(high,low,close), mutate_fun = stoch)
output$ind_stoch <- renderHighchart({
req(input$stoch_fastk)
req(input$stoch_fastd)
req(input$stoch_slowd)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = stoch,
nFastK= input$stoch_fastk,
nFastD = input$stoch_fastd,
nSlowD = input$stoch_slowd) %>%
mutate(stoch = stoch *100,
lower_level = 20,
upper_level = 80) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$stoch, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# RSI(price, n=14, maType="WMA", wts=ttrc[,"Volume"])
# aapl %>% tq_mutate(select = adjusted, mutate_fun = RSI)
output$ind_rsi <- renderHighchart({
req(input$rsi_n)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = RSI,
n = input$rsi_n) %>%
mutate(lower_level = 30,
upper_level = 70) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$rsi, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# CCI(HLC, n = 20, maType, c = 0.015, ...)
output$ind_cci <- renderHighchart({
req(input$cci_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = CCI,
n = input$cci_n) %>%
mutate(lower_level = -100,
upper_level = 100) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$cci, color = "blue", yAxis = 1, name = "CCI") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, name = "Oversold",
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, name = "Overbought", tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# aroon(HL, n = 20)
# aapl %>% tq_mutate(select = c(high,low), mutate_fun = aroon)
output$ind_aroon <- renderHighchart({
req(input$aroon_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low), mutate_fun = aroon,
n = input$aroon_n) %>%
filter(date >= input$tech_date_range[[1]]) %>%
mutate(lower_level = -100,
upper_level = 100)
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$aroonUp, color = "green", yAxis = 1, name = "Up") %>%
hc_add_series(ind_xts$aroonDn, color = "red", yAxis = 1, name = "Down" ) %>%
hc_add_series(ind_xts$oscillator, color = "blue", yAxis = 2, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "black",yAxis = 2,
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 2, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# OBV(price, volume)
output$ind_obv <- renderHighchart({
ind_df <- tech_price() %>%
tq_mutate_xy(adjusted,volume, mutate_fun = OBV) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$obv, color = "blue", yAxis = 1, name = "On Balance Volume") %>%
hc_tooltip(valueDecimals = "2")
})
# Need to Join Seperately
# ADX(HLC, n = 14, maType, ...)
output$ind_adx <- renderHighchart({
req(input$adx_n)
ind_df <- tech_price() %>% tq_transmute(select = c(high,low,close), mutate_fun = ADX, n = input$adx_n) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$DIp, color = "green", yAxis = 1, name = "Positive") %>%
hc_add_series(ind_xts$DIn, color = "red", yAxis = 1, name = "Negative") %>%
hc_add_series(ind_xts$ADX, color = "black", yAxis = 2, name = "ADX") %>%
hc_add_series(ind_xts$DX, color = "blue", yAxis = 2, name = "DX") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_bbands <- renderHighchart({
req(input$bbands_n)
req(input$bbands_sd)
# BBands(HLC, n = 20, maType, sd = 2, ...)
ind_df <- tech_price() %>% tq_transmute(select = adjusted,
mutate_fun = BBands,
n= input$bbands_n,
sd= input$bbands_sd) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
mutate(upper_level = 1,
lower_level = 0) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$dn, color = "green", yAxis = 0, name = "Lower") %>%
hc_add_series(ind_xts$up, color = "red", yAxis = 0, name = "Upper") %>%
hc_add_series(ind_xts$mavg, color = "black", yAxis = 0, name = "Moving Average") %>%
hc_add_series(ind_xts$pctB, color = "blue", yAxis = 1, name = "% B") %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$lower_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_tooltip(valueDecimals = "2")
})
# Pricing Data------------------
q_pricing <- reactive({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
tq_get(input$ticker_1,
from = input$price_date_range[[1]],
to = input$price_date_range[[2]])
# df <- q_price(ticker,
# start_date = input$price_date_range[[1]],
# end_date = input$price_date_range[[2]],
# frequency = input$price_freq) %>%
# select(q_ticker,
# date,
# adjOpen,
# adjLow,
# adjHigh,
# adjClose,
# adjVolume,
# divCash,
# splitFactor)
#
# df
})
# Pricing Chart------------------------
output$price_chart <- renderHighchart({
price_dt <- q_pricing()
price_xts <- xts(price_dt[-1],price_dt$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(price_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(price_xts$volume, yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$pricing_dt <- renderRHandsontable({
q_pricing() %>%
arrange(desc(date)) %>%
rhandsontable(stretchH = "all")
})
output$div_plot <- renderPlotly({
req(input$ticker_1)
divs <- tq_get(input$ticker_1,
get = "dividends")
if("dividends" %in% colnames(divs)){
divs %>%
plot_ly(x = ~date,
y = ~dividends,
type = 'scatter',
mode = 'lines',
fill = 'tozeroy') %>%
layout(title = paste0(input$ticker_1," Dividends Over Time"),
plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
}
})
# Returns Data -----------------------------------
output$returns_dt <- renderText({
req(input$ticker_1)
req(input$returns_benchmark)
ticker <- as.character(input$ticker_1)
benchmark <- as.character(input$returns_benchmark)
q_return_stats_full(ticker,
benchmark,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]])
})
# Performance Chart-----------------------------
output$performance_chart <- renderPlotly({
req(input$ticker_1)
req(input$returns_benchmark)
ticks <- c(input$ticker_1,input$returns_benchmark)
# plot -----------------------
plot.df <- q_price(ticks,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]],
frequency = input$returns_freq)%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = input$returns_freq,
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,input$returns_freq," Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = "")) %>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
# Key Returns --------------------
output$key_returns <- renderDataTable({
req(input$ticker_1)
req(input$returns_benchmark)
tick_key_rets <- q_key_returns(input$ticker_1)
bench_key_rets <- q_key_returns(input$returns_benchmark)
tick_key_rets %>%
full_join(bench_key_rets) %>%
DT::datatable(rownames=F,options = list(dom = "t")) %>%
formatPercentage(2:11)
})
# Calendar Returns------------------
output$calendar_returns <- renderDataTable({
req(input$ticker_1)
cal_returns<- q_return(input$ticker_1,frequency = "monthly")
nms <- tibble(
mnth_abbrev = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"),
mnth = c(1,2,3,4,5,6,7,8,9,10,11,12))
cal_returns %>%
select(date,monthly_return) %>%
mutate(mnth = month(date),
year = year(date)) %>%
left_join(nms,by = "mnth") %>%
select(-date,-mnth) %>%
spread(mnth_abbrev,monthly_return) %>%
select(year,nms$mnth_abbrev) %>%
arrange(desc(year)) %>%
DT::datatable(rownames=F, options = list(dom = 'tp')) %>%
formatPercentage(nms$mnth_abbrev,1)
})
company_news <-reactive({
req(input$ticker_1)
q_news(input$ticker_1,
sources = input$news_sources)
})
output$news_bub <- renderBubbles({
company_news <- company_news()
company_news %>%
select(tickers) %>%
unnest() %>%
count(tickers) %>%
filter(tickers != str_to_lower(input$ticker_1)) %>%
mutate(tickers = str_to_upper(tickers)) %>%
arrange(desc(n)) %>%
slice(1:5) %>%
mutate(color = rep_len(tol12qualitative,5)) %>%
bubbles::bubbles(value = .$n,
label = .$tickers,
tooltip = .$n,
color = .$color,
textColor = "white")
# mutate(color = rep_len(brewer.pal(8,"Dark2"),15)) %>%
# bubbles::bubbles(value = .$n,label = .$tickers,
# color = .$color)
})
output$news_cloud <- renderWordcloud2({
req(input$ticker_1)
company_news <- company_news()
company_descrip <- company_news %>%
pull(description)
descrip_df <- tibble(line = 1:length(company_descrip), text = company_descrip)
text_count <- descrip_df %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
sent <- text_count %>%
inner_join(get_sentiments(input$news_lex)) %>%
count(word) %>%
rename(freq = n)
descrip_df <- descrip_df %>%
unnest_tokens(word,text) %>%
count(word) %>%
anti_join(stop_words) %>%
arrange(desc(n)) %>%
rename(freq = n)
if(input$sent_filt){
# Wordcloud
sent %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
} else{
descrip_df %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
}
})
# News DT--------------------
output$news_dtt <- DT::renderDataTable({
req(input$ticker_1)
company_news <- company_news()
company_news <- company_news %>%
dplyr::select(title,description,source,published_date,url) %>%
mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
dplyr::select(-url)
dt <- company_news %>%
DT::datatable(rownames = F,selection = 'single',
escape = F,
class = 'cell-border stripe',
options = list(
columnDefs = list(
list(width = '300px', targets = c(0,1)),
list(width = '100px', targets = c(2,3)),
list(height = '100px', targets = "_all"),
list(className = 'dt-center',targets = c(2,3)),
list(className = 'dt-right',targets = 0))))
dt %>% formatDate(4,'toUTCString') %>%
DT::formatStyle(columns = 1, fontSize = '20px')
})
# tr_script <- reactive({
# q_transcript(input$ticker_1)
#
#
# })
#
#
#
# # Filings ---------------------------------
# output$transcript <- renderDataTable({
# library(rebus)
# req(input$ticker_1)
#
#
# tp <- tr_script() %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title)
#
# tp %>%
# DT::datatable(escape = F, rownames = F,
# options = list(pageLength = 20,
# columnDefs = list(list(className = 'dt-center',targets = "_all"))))
#
#
# })
# output$tr_df <- renderDataTable({
#
# library(rebus)
# t <- t_script
#
# t <- t %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title) %>% datatable(escape = F)
#
# t
#
# })
text_df <- reactive({
req(input$ticker_1)
t_script <- q_transcript(input$ticker_1)
t_ext <- t_script %>%
slice(1) %>%
pull(link) %>%
read_html() %>%
html_nodes("p") %>%
html_text()
data_frame(line = 1:length(t_ext), text = t_ext)
})
sent <- reactive({
text_count <- text_df() %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
text_count %>%
inner_join(get_sentiments("loughran"))
})
output$word_cloud <- renderWordcloud2({
# sent() %>%
# count(word, sentiment, sort = TRUE) %>%
# acast(word ~ sentiment, value.var = "n", fill = 0) %>%
# comparison.cloud(colors=rev(brewer.pal(3,"Dark2")[1:2]),
# max.words = 50)
sent() %>% count(word) %>% rename(freq = n) %>% wordcloud2(size=1.3,
backgroundColor = 'rgb(236,240,245)')
})
output$sent_chart <- renderPlotly({
gg <- sent() %>%
filter(sentiment != "superfluous", sentiment != "constraining") %>%
filter(!str_detect(word,"question")) %>%
count(word,sentiment,sort = T) %>%
group_by(sentiment) %>%
slice(1:5) %>%
ungroup() %>%
# mutate(n = ifelse(sentiment=="negative",-n,n)) %>%
mutate(word = str_to_title(word)) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free") +
labs(y = NULL,
x = NULL) +
coord_flip()+
theme_minimal()
# Sentiment Plotly
ggplotly(gg)%>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
output$some_text <- renderText({
if(!is.null(input$search) & input$search != ""){
text_df <- text_df() %>%
filter(str_detect(text,input$search)) %>%
mutate(text = str_replace_all(text,input$search,paste0("<mark>",input$search,"</mark>")))
t_script <- paste(text_df$text,collapse="<br><br>")
} else {
text_df <- text_df()
t_script <- paste(text_df$text,collapse="<br><br>")
}
paste0("<h4>",t_script,"</h4>")
})
output$ten_k_q_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$ten_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$eight_k_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$eight_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$prospectus_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$pros_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$proxy_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$proxy_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$thirteen_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$thirteen_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
}))
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.